home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / p4 / p4-1_2b.lha / p4-1.2b / messages_f / sr_test.f < prev    next >
Text File  |  1993-02-10  |  3KB  |  120 lines
  1.       program systest
  2.  
  3.       include 'p4f.h'
  4.  
  5.       call p4init()
  6.       call p4crpg()
  7.       if (p4myid() .eq. 0) then
  8.       call fmaster()
  9.       else
  10.       call fslave()
  11.       endif
  12.       call p4cleanup()
  13.       print *,'mainline exiting normally'
  14.       end
  15.  
  16.  
  17.       subroutine fmaster()
  18.  
  19.       include 'p4f.h'
  20.  
  21.       integer i,slaves,type,from,retcde,recvlen,buflen
  22.       character*40 buffer
  23.       integer TAGCNT, TAGDAT, TAGEND
  24.       parameter (TAGCNT = 10)
  25.       parameter (TAGDAT = 20)
  26.       parameter (TAGEND = 30)
  27.  
  28.       print 11,'Entering fmaster'
  29. 11    format(a)
  30.       slaves = p4ntotids() - 1
  31.       length = 0
  32.       buflen = 40
  33.  
  34.       do 10 i = 1,slaves
  35.          call p4sendr(TAGCNT,i,buffer,length,retcde)
  36. 10    continue
  37.  
  38. 20    print *,'Enter a string: '
  39.       read (*,99,end=50) buffer
  40. 99    format(a40)
  41.  
  42.       do 30 length=40,1,-1
  43.          if(buffer(length:length) .ne. ' ') goto 40
  44. 30    continue
  45.       length = 0
  46. 40    continue
  47.  
  48.       call p4send(TAGDAT,1,buffer,length,retcde)
  49.       buffer = ' '
  50.       type = TAGDAT
  51.       from = -1
  52.       call p4recv(type,from,buffer,buflen,recvlen,retcde)
  53.  
  54.       print *,'MASTER receives from=',from,' buffer=',buffer
  55.       length = 0
  56.       goto 20
  57. 50    continue
  58.  
  59.       do 60 i = 1,slaves
  60.          call p4sendr(TAGEND,i,buffer,buflen,retcde)
  61. 60    continue
  62.  
  63.       print *,'Master exiting normally'
  64.       end
  65.  
  66.  
  67.       subroutine fslave()
  68.  
  69.       include 'p4f.h'
  70.  
  71.       character*40 buffer
  72.       integer type, from, next, done, procid, length, buflen
  73.       integer numsl, retcde, recvlen
  74.       integer TAGCNT, TAGDAT, TAGEND
  75.       parameter (TAGCNT = 10)
  76.       parameter (TAGDAT = 20)
  77.       parameter (TAGEND = 30)
  78.  
  79.       numsl = p4ntotids() - 1
  80.       procid = p4myid()
  81.       buflen = 40
  82.  
  83. C     print 200,'slave ',procid,' has started'
  84. C200  format(a,i2,a)
  85. C     call p4flush
  86.  
  87.       if (procid .eq. numsl) then
  88.          next = 0
  89.       else
  90.          next = procid + 1
  91.       endif
  92.  
  93. C     print 201,'slave ',procid,' next = ',next
  94. C201  format(a,i2,a,i2)
  95. C     call p4flush
  96.  
  97.       length = 40
  98.       from = -1
  99.       type = TAGCNT
  100.       call p4recv(type,from,buffer,length,recvlen,retcde)
  101.       done = 0
  102.  
  103. 50    if (done .ne. 0) goto 100
  104.  
  105.          buffer = ' '
  106.          length = 40
  107.          from = -1
  108.          type = -1
  109.          call p4recv(type,from,buffer,length,recvlen,retcde)
  110.          if (type .eq. TAGEND) then
  111.             done = 1
  112.          else
  113.             call p4send(TAGDAT,next,buffer,recvlen,retcde)
  114.          endif
  115.          goto 50
  116.  
  117. 100   continue
  118.  
  119.       end
  120.